home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / clocks.zip / CLOCKWRK.PAS < prev   
Pascal/Delphi Source File  |  1990-12-17  |  6KB  |  260 lines
  1. program TestPlatform;
  2.  
  3. uses Objects, Drivers, Views, Menus, App,
  4.      Dos,     { for the paramcount and paramstr funcs}
  5.      Clocks;  { for the clock on the menubar object, TClockMenu }
  6.  
  7. { This generic test platform has been hooked up to the clock-on-the-menubar
  8.   object / unit.  Search for *** to find hook-up points.
  9.  
  10.   Copyright (c) 1990 by Danny Thorpe
  11. }
  12.  
  13.  
  14. const  cmNewWin =   100;
  15.        cmFileOpen = 101;
  16.  
  17.        WinCount : Integer = 0;
  18.        MaxLines = 50;
  19.  
  20.  
  21. type  PInterior = ^TInterior;
  22.       TInterior = object(TScroller)
  23.         constructor init(var Bounds: TRect; AHScrollbar, AVScrollbar: PScrollbar);
  24.         procedure Draw;  virtual;
  25.         end;
  26.  
  27.  
  28.       PDemoWindow = ^TDemoWindow;
  29.       TDemoWindow = object(TWindow)
  30.         constructor Init(WindowNo: integer);
  31.         end;
  32.  
  33.  
  34.       TMyApp = object(TApplication)
  35.         procedure InitStatusLine;  virtual;
  36.         procedure InitMenuBar;  virtual;
  37.         procedure NewWindow;
  38.         procedure HandleEvent( var Event: TEvent); virtual;
  39.         procedure Idle; virtual;
  40.         end;
  41.  
  42.  
  43. var MyApp: TMyApp;
  44.     Lines: array [0..MaxLines-1] of PString;
  45.     LineCount: Integer;
  46.  
  47.  
  48. constructor TInterior.Init(var Bounds: TRect; AHScrollbar, AVScrollbar: PScrollbar);
  49.   begin
  50.   TScroller.Init(Bounds,AHScrollbar,AVScrollbar);
  51.   Growmode := gfGrowHiX + gfGrowHiY;
  52.   Options := Options or ofFramed;
  53.   SetLimit(128,LineCount);
  54.   end;
  55.  
  56.  
  57. procedure TInterior.Draw;
  58.   var color: byte;
  59.       y,i: integer;
  60.       B: TDrawBuffer;
  61.  
  62.   begin
  63.   TScroller.Draw;
  64.   Color := GetColor($01);
  65.   for y:= 0 to Size.Y -1 do
  66.     begin
  67.     MoveChar(B,' ',Color,Size.X);
  68.     I := Delta.Y + Y;
  69.     if (I<Linecount) and (Lines[I] <> nil) then
  70.       MoveStr(B,Copy(Lines[I]^,Delta.X+1,size.x),Color);
  71.     WriteLine(0,y,size.x,1,B);
  72.     end;
  73.   end;
  74.  
  75.  
  76. procedure ReadFile;
  77.   var  F: text;
  78.        S: string;
  79.  
  80.   begin
  81.   LineCount:=0;
  82.   if paramcount = 0 then
  83.     assign(F,'clockwrk.pas')
  84.   else
  85.     assign(F,paramstr(1));
  86.   reset(F);
  87.   while not eof(F) and (linecount < maxlines) do
  88.     begin
  89.     readln(f,s);
  90.     Lines[Linecount] := NewStr(S);
  91.     Inc(LineCount);
  92.     end;
  93.   Close(F);
  94.   end;
  95.  
  96.  
  97.  
  98.  
  99.  
  100. constructor TDemoWindow.Init(WindowNo: Integer);
  101.   var  LInterior, RInterior: PInterior;
  102.        HScrollbar, VScrollbar: PScrollbar;
  103.        R: TRect;
  104.        Center: integer;
  105.  
  106.   begin
  107.     R.Assign(0,0,40,15);
  108.     R.Move(Random(40),Random(8));
  109.  
  110.     TWindow.Init(R, 'Window', wnNoNumber);
  111.     GetExtent(R);
  112.     Center:= (R.B.X + R.A.X) div 2;
  113.     R.Assign(Center,R.A.Y+1,Center+1,R.B.Y-1);
  114.     VScrollbar:= new(PScrollbar, Init(R));
  115.     with VScrollbar^ do Options := Options or ofPostProcess;
  116.     Insert(VScrollbar);
  117.     GetExtent(R);
  118.     R.Assign(R.A.X+2,R.B.Y-1,Center-1,R.B.Y);
  119.     HScrollbar:= new(PScrollbar, Init(R));
  120.     with HScrollbar^ do Options := Options or ofPostProcess;
  121.     Insert(HScrollbar);
  122.     GetExtent(R);
  123.     R.Assign(R.A.X+1,R.A.Y+1,Center,R.B.Y-1);
  124.     LInterior:= new(PInterior, Init(R, HScrollbar, VScrollbar));
  125.     with LInterior^ do
  126.       begin
  127.       Options:= Options or ofFramed;
  128.       Growmode:= GrowMode or gfGrowHiX;
  129.       SetLimit(128,LineCount);
  130.       end;
  131.     Insert(LInterior);
  132.  
  133.     GetExtent(R);
  134.     R.Assign(R.B.X-1,R.A.Y+1,R.B.X,R.B.Y-1);
  135.     VScrollbar:= new(PScrollbar, Init(R));
  136.     with VScrollbar^ do Options := Options or ofPostProcess;
  137.     Insert(VScrollbar);
  138.     GetExtent(R);
  139.     R.Assign(Center+2,R.B.Y-1,R.B.X-2,R.B.Y);
  140.     HScrollbar:= new(PScrollbar, Init(R));
  141.     with HScrollbar^ do
  142.       begin
  143.       Options := Options or ofPostProcess;
  144.       GrowMode:= GrowMode or gfGrowLoX;
  145.       end;
  146.     Insert(HScrollbar);
  147.     GetExtent(R);
  148.     R.Assign(Center+1,R.A.Y+1,R.B.X-1,R.B.Y-1);
  149.     RInterior:= new(PInterior, Init(R, HScrollbar, VScrollbar));
  150.     with RInterior^ do
  151.       begin
  152.       Options:= Options or ofFramed;
  153.       Growmode:= GrowMode or gfGrowLoX;
  154.       SetLimit(128,LineCount);
  155.       end;
  156.     Insert(RInterior);
  157.     end;
  158.  
  159.  
  160.  
  161.  
  162. procedure TMyApp.InitStatusLine;
  163.   var R: TRect;
  164.  
  165.   begin
  166.   GetExtent(R);      { find out how big the current view is }
  167.   R.A.Y := R.B.Y-1;  { squeeze R down to one line at bottom of frame }
  168.   StatusLine := New(PStatusline, Init(R,
  169.                   NewStatusDef(0, $FFFF,
  170.                     NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
  171.                     NewStatusKey('~F4~ New', kbF4, cmNewWin,
  172.                     NewStatusKey('~Alt-F3~ Close', kbAltF3, cmClose,
  173.                     nil))),
  174.                   nil)
  175.                 ));
  176.   end;
  177.  
  178.  
  179. { *** The vvv below indicate the primary hook-up point for the menubar-clock.
  180.   This programmer-defined normal menu structure will be tacked onto the
  181.   end of the clock menubar in TClockMenu.Init.
  182. }
  183.  
  184. procedure TMyApp.InitMenuBar;
  185.   var R: TRect;
  186.  
  187.   begin
  188.   GetExtent(R);       {***}
  189.   r.b.y:= r.a.y+1;   { vvv }
  190.   Menubar := New(PClockMenu, Init(R, NewMenu(
  191.                NewSubMenu('~F~ile', hcNoContext, NewMenu(
  192.                  NewItem('~O~pen','F3', kbF3, cmFileOpen, hcNoContext,
  193.                  NewItem('~N~ew','F4', kbF4, cmNewWin, hcNoContext,
  194.                  NewLine(
  195.                  NewItem('E~x~it','Alt-X', kbAltX, cmQuit, hcNoContext,
  196.                  nil))))),
  197.                NewSubMenu('~W~indow', hcNoContext, NewMenu(
  198.                  NewItem('~N~ext','F6', kbF6, cmNext, hcNoContext,
  199.                  NewItem('~Z~oom','F7', kbF7, cmZoom, hcNoContext,
  200.                  nil))),
  201.                nil))    { one ) for each menu defined }
  202.              )));
  203.   end;
  204.  
  205.  
  206. procedure TMyApp.NewWindow;
  207.   var
  208.     Window: PDemoWindow;
  209.     R: TRect;
  210.  
  211.   begin
  212.   inc(WinCount);
  213.   Window:= New(PDemoWindow, Init(WinCount));
  214.   Desktop^.Insert(Window);
  215.   end;
  216.  
  217.  
  218.  
  219.  
  220. {*** clock hook-up point - typecasting required to access "new" method }
  221.  
  222. procedure TMyApp.Idle;
  223.   begin
  224.   TApplication.Idle;
  225.   PClockMenu(MenuBar)^.Update;
  226.   end;
  227.  
  228.  
  229.  
  230.  
  231. procedure TMyApp.HandleEvent( var Event: TEvent);
  232.   begin
  233.   TApplication.HandleEvent(Event);
  234.   if Event.What = evCommand then
  235.     begin
  236.       case Event.Command of
  237.         cmNewWin: NewWindow;
  238.       else  { case }
  239.         Exit;
  240.       end;  { case }
  241.       ClearEvent(Event);
  242.     end; {if}
  243.   end;
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  
  250.  
  251.  
  252. begin
  253.  
  254. readfile;
  255.  
  256. MyApp.Init;
  257. MyApp.run;
  258. MyApp.done;
  259. end.
  260.